# This program replaces the annotation with the code.
#   Written by prepress-tips 2010.05.30 - 2010.07.10
#   Contact: prepress-tips@users.sourceforge.jp
# This program is under the same licensing terms as Perl
# ( the Artistic License 1.0 or the GNU GPL ).
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=pod - 構造と処理の記述（ ver 0.04 ）

  構造を 行頭の記号 で認識する。包含関係は インデントで認識する。
    /?              １行のみの注釈
    _/?             １行のみの注釈
    /?? ～ ??/      複数行にわたる注釈
    /+ ～           注釈による処理の記述
    /~ …           継続行
    /+ … / ～      言語シンボルの宣言 と 注釈による処理の記述
    / ～            日本語シンボルによる処理の記述
    _/ ～           同上 ～の中に / がある場合も処理
    /~ …           継続行
    _/~ …          継続行
    ** ～ / …      日本語構文の言語シンボルへの置換の定義
    *~ ～           継続行
    * ～ / …       日本語シンボルの言語シンボルへの置換の定義
    * ～ /          日本語シンボルの言語コードへの置換の定義
    * ～ //         同上  ～ を ～ ... に置換して処理
    * ～ // …      日本語シンボルの言語シンボルへの置換の定義
                    ～ を ～ ... に置換して処理
    *~ …           継続行
    ? ～            日本語シンボルの定義
    ? ～ / …       日本語シンボルとその言語シンボルへの置換を同時に定義
    ?~ …           継続行
    ? / …          言語シンボルのみの定義
    ? ～ // …      日本語シンボルとその言語シンボルへの置換を同時に定義し
                    さらに / ～ ... を自動的に挿入
    ? ～ //         日本語シンボルの定義
                    さらに / ～ ... を自動的に挿入
    /name  ～ / …  ブロック名と出力ファイル
    /name  ～       ブロック名のみの指定

  ※ 対応する言語は perl, java 。出力ファイルの拡張子で判断する。
     * ～ / , ** ～ / , * ～ // の ～ のところは 正規表現で記述する。
     また この中で / は使わないこと。
     上記に該当しないところは 言語コード部と認識する。
     空行は 言語コードの後ろの空行を言語コードの空行と認識する。
     /name以降のブロックは ファイル先頭に転記する。
     行末に 必要に応じて ; を挿入するが、その際
     空白＋注釈記号（ # または // ）を無条件に注釈と判断するので注意すること。
=cut

=pod - 日本語構文の置換の定義例

    ** ( ？？ )ならば( ？？ ) / if( $1 ) { $2 }
    ** そうでなければ( ？ ) / else { $1 }
    ** ( ？ )を戻す / return $1 ;
    ** かつ / &&
    ** ( array )に( ？ )処理を繰り返す。 / for( $1 ) { $2 }

  ※ ？？は すべての文字とマッチングする。
     ？は { } の内側だけをマッチングする。
     英数字文字列で指定すると 空白を含まない文字列とマッチングする。
=cut

=pod - 日本語シンボルの言語シンボルへの置換の定義例

    * ( m )をエラー表示する / err( m )
    ? ( m )をエラー表示する / msg( m )
        print $_[0]."\x0a";
    ? 状態 *[(]( s )[)] / State( s )
        bless { state => $_[0] };
    * 終了する /
        exit( 0 );
=cut

=pod - 起動時オプション

    perl   codeLayouter.pl   入力ファイル   [pld]
        p : 構文の変換規則を表示する
        l : 日本語シンボルの変換規則を表示する
        d : 言語コードへの変換規則を表示する

        ※ 出力ファイルは /name で指定する。
=cut

# - 処理の構造

    { # codeLayouterの処理
        { # ファイルを読む。
            # 開始メッセージを表示する。
                msg( 'codeLayouter started', ' ( ver 0.04 )' );
                $opt; { # 表示オプション
                    $opt = @ARGV > 1 ? $ARGV[1] : "" ;
                    $opt eq "" || msg( 'option :', "  $opt" );
                }
            # indexファイルを読む。
                my $fn; { # ファイル名（ 存在も確認 ）
                    @ARGV > 0 || err( 'ファイル名を指定してください。' );
                    $fn = $ARGV[0];
                    -f $fn || err( 'ファイルがありません。' );
                }
                @in; { # ファイルの内容
                    @in = map do { s/\s*$//; $_; }, getF( $fn );
                    msg( 'index :', "  $fn" );
                }
            # use文を処理する。
                my @fn; { # ファイル名
                    @fn = map do { /^\s*\/use[\s\/]/i ? $_ : () }, @in;
                    @in = map do { /^\s*\/use[\s\/]/i ? () : $_ }, @in;
                }
                { # 存在するもののみ選択
                    @fn = map do {
                        my $f = /^\s*\/use(?=(\s|\/)).*?\/\s*[\'\"]?/ ? $' :
                                /^\s*\/use\s*[\'\"]?/ ? $' :
                                "" ;
                        $f =~ s/[\'\"]?\s*$//;
                        $f ne "" && -f $f ? $f : ();
                    }, @fn;
                }
                { # 読む
                    msg( 'use :' );
                    for( @fn ) {
                        msg( "  $_" );
                        push @in, map do { s/\s*$//; $_; }, getF( $_ );
                    }
                }
        }
        { # 日本語構文の定義を読む。
            # 行頭記号
                    @re = (
                        '\/name(?=\s|\/|$)',
                        '_?\/\?', '\/\+', '_\/', '\/(?!\*)(?!.*\/)', '\*(?=.+\/)', '\?(?=[~\s])',
                    );
            # 複数行にわたる注釈を１行にまとめる。
                my @new; { # 処理結果
                    @new = (); my $c = 0;
                    for( @in ) {
                        if( $c ) { # 注釈の途中
                            my $p = @new ? pop @new : "" ; push @new, "$p\x0a$_";
                            /^\s*\?\?\// && ( $c = 0 ); next;
                        }
                        push @new, $_;
                        /^\s*\/\?\?/ && ( $c = 1 ); # 注釈の始まり
                    }
                }
                { # 更新
                    @in = @new;
                }
            # 継続行 を１行にまとめる。
                my @new; { # 処理結果
                    @new = ();
                    for( @in ) {
                        if( /^\s*(_?\/|\*\*?|\?)\~\s*/ ) { # 継続行
                            my $k = "\\$1"; my $p = $';
                            $k eq "//" && ( $k = '.*//' );
                            if( @new && $new[ @new - 1 ] =~ m/^\s*$k/ ) { # 確認
                                $new[ @new - 1 ] .= " $p";
                                ### msg( "*** 継続行 *** ".$new[ @new - 1 ] ); # debug用
                                next;
                            }
                        }
                        push @new, $_;
                    }
                }
                { # 更新
                    @in = @new;
                }
            # name文の後ろの言語コードを１行にまとめる。
                my @new; { # 処理結果
                    @new = (); my $c = 0;
                    for( @in ) {
                        if( $c ) { for $m ( @re ) { /^\s*$m/ && ( $c = 0, last ); } }
                        $c && @new && ( @new[ @new - 1 ] .= "\x0a$_", next ); # 言語コード
                        push @new, $_;
                        /^(\s*)\/name(\s|\/|$)/i && ( $c = 1 ); # name文の始まり
                    }
                }
                { # 更新
                    @in = @new;
                }
            # name文から言語を調べる。
                my @e; { # 拡張子の一覧
                    @e = map do { /^\s*\/name(\s.*)?\/\s*/i ? $' : () ; }, @in;
                    @e = map do { /\.(\w+)['"]?\s*?(\x0a|$)/ ? lc( $1 ) : "none" ; }, @e;
                    @e = sort { $a cmp $b } @e;
                    my $n = ""; @e = map do { my $p = $n; $n = $_; $p eq $n ? () : $n ; }, @e;
                }
                my %ext_lang; { # 拡張子と言語
                    %ext_lang = (
                        'pm' => 'perl', 'pl' => 'perl', 'pls' => 'perl',
                        'java' => 'java',
                    );
                }
                $lang; { # 言語
                    my @l = map do { defined( $ext_lang{ $_ } ) ? $ext_lang{ $_ } : $_ ; }, @e;
                    $lang = @l ? join ', ', @l : 'perl' ;
                }
                ( $com_mark, $com_start, $com_end ); { # 注釈の記号
                    ( $com_mark, $com_start, $com_end ) = ( '//', '/*', '*/' );
                    $lang eq "perl" && (
                        ( $com_mark, $com_start, $com_end ) = ( '#', '=pod', '=cut' )
                    );
                }
                { # 表示
                    msg( 'language :', map do { "  $_" }, split ", ", $lang );
                }
            # javaのとき 同じクラスをまとめる。
                    my @c; my $c = 0;
                    if( $lang eq 'java' ) {
                        while( @c = find_class_for_java() ) {
                            my ( $is, $js, ) = @c;
                            my $ie = class_end_for_java( $is );
                            my $je = class_end_for_java( $js );
                            my @cut = splice( @in, $js, $je - $js );
                            { # インデントを揃える
                                $cut[ 0 ] =~ /^\s*/;  my $ind_s = $&;
                                $in[ $is ] =~ /^\s*/; my $ind_d = $&;
                                for( @cut ) { $_ =~ /^\s*$/ || s/^$ind_s/$ind_d/; }
                            }
                            { # 先頭の行を統合
                                $in[ $is ] =~ /^\s*\?.*\/\s*(.*\s)?class\s+\w/ ||
                                    ( $in[ $is ] = $cut[ 0 ] );
                                shift @cut;
                            }
                            splice( @in, $ie, 0, @cut );
                        }
                    }
            # 日本語構文の言語シンボルへの置換 の定義を読む（ ** ）。
                @parse; { # 定義を抽出
                    @parse = map do { /^\s*\*\*.+\/\s*\S.*\s*$/ ? $_ : () }, @in;
                    @in    = map do { /^\s*\*\*.+\/\s*\S.*\s*$/ ? () : $_ }, @in;
                }
                { # 定義を整形
                    for( @parse ) {
                        s/^\s*\*\*\s*//; s/\s*$//;
                        /\s*\/\s*/; my $k = $`; my $v = $';
                        $k =~ s/\(\s*？？\s*\)/((?:.|\\s)*)/g;
                        $k =~ s/\(\s*？\s*\)/([^{}]*)/g;
                        $k =~ s/\(\s*\w+\s*\)/\\s*(\\S+)\\s*/g;
                        $_ = [ $k, $v, quotemeta_ja( $k ), ];
                    }
                }
                my @no_sym; { # 日本語構文がないものを抽出
                    @no_sym = map do { @$_[0] =~ /\S/ ? () : @$_[1] ; }, @parse;
                    @parse  = map do { @$_[0] =~ /\S/ ? $_ : () ;     }, @parse;
                }
                { # 表示
                    $opt =~ /p/i && msg(
                        'parse :',
                        ( map do { "  @$_[0] : @$_[1]" }, @parse ),
                        ( map do { "  * no symbol : $_" }, @no_sym ),
                    );
                }
            # 日本語シンボルの言語シンボルへの置換 の定義を読む（ * ）。
                @label_1; { # 定義を抽出
                    @label_1 = map do { /^\s*\*(?!.*\/\/).+\/(?=.*\S)\s*\S.*\s*$/ ? $_ : () }, @in;
                    @in      = map do { /^\s*\*(?!.*\/\/).+\/(?=.*\S)\s*\S.*\s*$/ ? () : $_ }, @in;
                }
                { # 定義を追加
                    push @label_1 , map {
                        /^(\s*\*.*?\S.*?)\s*\/\/\s*(?=.*\S)/ ? "$1 / $'" : ()
                    } @in ;
                }
                { # 定義を読み替え
                    for( @in ){
                        /^(\s*\*.*?\S)\s*\/\/\s*/ && ( $_ = "$1 \\.\\.\\. /" , s/[()]/\\$&/g ) ;
                    }
                }
                { # 定義を整形
                    for( @label_1 ) {
                        s/^\s*\*\s*//; s/\s*$//;
                        /\s*\/\s*/; my $k = $`; my $v = $';
                        $_ = [ $k, $v, quotemeta_ja( $k ), ];
                    }
                }
                my @no_sym; { # 日本語シンボルのないものを抽出
                    @no_sym  = map do { @$_[0] =~ /\S/ ? () : @$_[1] ; }, @label_1;
                    @label_1 = map do { @$_[0] =~ /\S/ ? $_ : () ;     }, @label_1;
                }
                { # 表示
                    $opt =~ /l/i && msg(
                        'label * / :',
                        ( map do { "  @$_[0] : @$_[1]" }, @label_1 ),
                        ( map do { "  * no symbol : $_" }, @no_sym ),
                    );
                }
            # 日本語シンボルの言語シンボルへの置換 の定義を読む（ ? ）。
                @label_2; { # 定義を抽出
                    @label_2 = map do {
                        /^\s*\?(?!.*\/\/).*\/\s*\S.*\s*$/ ? $_         :
                        /^(\s*\?.*)\/\/(\s*\S.*\s*)$/     ? "$1/$2"    :
                        /^(\s*)\*(.*)\/\/(\s*\S.*\s*)$/   ? "$1?$2/$3" :
                        ()
                    }, @in;
                }
                { # 定義を整形
                    for( @label_2 ) {
                        s/^\s*\?\s*//; s/\s*$//;
                        /\s*\/\s*/; my $k = $`; my $v = $';
                        $_ = [ $k, $v, quotemeta_ja( $k ), ];
                    }
                }
                { # 日本語シンボルのないものを除去
                    @label_2 = map do { @$_[0] =~ /\S/ ? $_ : () ;    }, @label_2;
                }
                { # 表示
                    $opt  =~ /l/i && msg(
                        'label ? / :', map do { "  @$_[0] : @$_[1]" }, @label_2
                    );
                }
            # 未定義の言語シンボルを自動発生する。
                $auto_name = 0; # 自動発生シンボル数
                @label_3; { # 言語シンボルが未定義の日本語シンボルを抽出
                    @label_3 = map do { /^\s*\?(?=\s)(?!.*\/\s*\S)/ ? $_ : () }, @in;
                }
                { # 定義済みでないとき 自動発生
                    my %label_1 = map do { ( @$_[0] => 1 ); }, @label_1;
                    @label_3 = map do {
                        /^\s*\?\s*(.*\S)\s*$/; my $k = $1; $k =~ s/\s*\/$//;
                        my $v = "";
                        if( ! defined( $label_1{ $k } ) ) {
                            $v = "auto_name_".++$autoname."()";
                            $lang eq 'java' && ( $v = "void $v" );
                        }
                        $v eq "" ? () : [ $k, $v, quotemeta_ja( $k ), ] ;
                    }, @label_3;
                }
                { # 定義を追加
                    push @label_1, @label_3;
                }
            # 言語コードへの置換の定義の後ろの 言語コードを１行にまとめる。
                my @new; { # 処理結果
                    @new = (); my $i = -1;
                    for( @in ) {
                        $i >= 0 && do { for $m ( @re ) {
                            /^(\s*)$m/ && length( $1 ) <= $i && ( $i = -1, last );
                        } };
                        $i >= 0 && @new && ( @new[ @new - 1 ] .= "\x0a$_", next ); # 言語コード
                        push @new, $_;
                        /^(\s*)\*.+\/\s*$/ && ( $i = length( $1 ) ); # 置換の定義の始まり
                    }
                }
                { # 更新
                    @in = @new;
                }
            # 日本語シンボルの言語コードへの置換 の定義を読む（ * ）。
                @direct; { # 定義を抽出
                    @direct = map do { /^\s*\*.+\// ? $_ : () }, @in;
                    @in     = map do { /^\s*\*.+\// ? () : $_ }, @in;
                }
                { # 定義を整形
                    for( @direct ) {
                        /^(\s*)/; my $indent = $1; s/^\s*\*\s*//;
                        /\s*\/.*/; my $k = $`; my $v = $';
                        $v =~ s/\x0a$indent/\x0a/g; $v =~ s/^\x0a//; $v =~ s/\s*$//;
                        $v =~ /(^|\x0a)\s*\?.*\/\/\s*(\x0a|$)/ && ( $v .= "\x0a    /?" );
                        $_ = [ $k, $v, quotemeta_ja( $k ), ];
                    }
                }
                { # 表示（ debug用 ）
                    ; ### msg( 'direct def :', map do { "  @$_[0] :", @$_[1] }, @direct );
                }
            # 定義間の余分な空行を削除する。
                    my $n = 0;
                    @in = map do { my $p = $n; $n = /\S/; $n || $p ? $_ : () ; }, @in;
            # 日本語シンボル→言語シンボル置換の置換テーブルを作る。
                %label; { # 日本語シンボル → 言語シンボル 置換テーブル（ 順序のないもの ）
                    %label = map do { ( @$_[0] => [ @$_[1] ] ); }, @label_1;
                }
                @label; { # 日本語シンボル → 言語シンボル 置換テーブル（ 順序のあるもの ）
                    @label = ( @label_1, @label_2 );
                }
                { # 引数の書式 を補正
                    for( @label ) { ref_argument( $_ ); }
                }
                { # 置換順序を変更
                    @label = sort sort_conv @label;
                }
                $direct_mark; { # 言語コードへの置換に使うマーク
                    $direct_mark = "/!!!/";
                    my @w = map do { /\/!+\//g; }, @in;
                    for( @w ) {
                        length( $direct_mark ) < length( $_ ) && ( $mk = $_ );
                    }
                    $direct_mark =~ s,/,,g; $direct_mark .= "!";
                }
                { # 言語コードへの１次置換を追加
                    my $i = 0;
                    my @d = map do {
                        [ @$_[0], "/$direct_mark/".$i++."/", @$_[2], ];
                    }, @direct;
                    unshift @label, sort sort_conv @d;
                }
                { # 表示（ debug用 ）
                    ; ### msg( 'label all :', map do { "  @$_[0] :", @$_[1] }, @label );
                }
        }
        { # 日本語構文を言語に変換する。
            # 構文
                @match; { # 構文
                    @match = (
                        { regexp => '^(\s*)(\/\?\?)',
                          start  => '$1."${com_start} ".$\'',
                          end    => '',
                        },
                        { regexp => '^(\s*)(_?\/\?)',
                          start  => '$1."${com_mark} ".$\'',
                          end    => '',
                        },
                        { regexp => '^(\s*)\/\+(.*)\s*\/',
                          start  => '$1.com_to_define( $\' )." { ${com_mark}".$2',
                          end    => '$1."}"',
                        },
                        { regexp => '^(\s*)\/\+',
                          start  => '$1."{ ${com_mark}".$\'',
                          end    => '$1."}"',
                        },
                        { regexp => '^(\s*)\?(?=\s)(?!.*\/\/)(?!.*\/+\s*\S)',
                          start  => '$1.label_to_code( $\' )." { ${com_mark}".$\'',
                          end    => '$1."}"',
                        },
                        { regexp => '^(\s*)\?(?=\s)(?=.*?\/\/)(?!.*?\/\/\s*\S)(.*?\S)\s*\/\/',
                          start  => '$1.label_to_code( $2 )." { ${com_mark}".$2.'.
                                    '"\x0a".proc_to_code( $2." ...", $1 )',
                          end    => '$1."}"',
                        },
                        { regexp => '^(\s*)\?(?=\s)(?!.*\/\/)(.*)\/\s*',
                          start  => '$1.code_to_define( $\' )." { ${com_mark}".$2',
                          end    => '$1."}"',
                        },
                        { regexp => '^(\s*)\?(?=\s)(?=.*\/\/)(.*?\S)\s*\/\/\s*',
                          start  => '$1.code_to_define( $\' )." { ${com_mark}".$2.'.
                                    '"\x0a".proc_to_code( $2." ...", $1 )',
                          end    => '$1."}"',
                        },
                        { regexp => '^(\s*)\/name(\s|\/|$)', # name文を除外
                          start  => '$&.$\'',
                          end    => '',
                        },
                        { regexp => '^(\s*)\/(?!.*\/)(?!\*)',
                          start  => '$1."${com_mark}".$\'."\x0a".proc_to_code( $\', $1 )',
                          end    => '',
                        },
                        { regexp => '^(\s*)_\/(?!\*)',
                          start  => '$1."${com_mark}".$\'."\x0a".proc_to_code( $\', $1 )',
                          end    => '',
                        },
                    );
                }
                @unknown; { # 未変換の日本語シンボル
                    @unknown = ();
                }
            # 言語コードへの置換の定義の日本語構文を 言語に変換する。
                my @cnv; { # 未変換の日本語構文
                    @cnv = @direct;
                    while( 1 ) {
                        my @c = @cnv; @cnv = ();
                        for( @c ) {
                            my $v = @$_[1]; my @v = split "\x0a", @$_[1];
                            while( Actions_Delta( \@v, \@match ) ) {};
                            @$_[1] = join "\x0a", @v;
                            $v eq @$_[1] || push @cnv, $_;
                        }
                        @cnv && @cnv < @c || last;
                    }
                }
                { # 処理結果を表示
                    $opt =~ /d/i &&
                        msg( 'direct :', map do { "  @$_[0] :", @$_[1] }, @direct );
                    @cnv && msg( 'convert not finished :', map do { "  @$_[0]"}, @cnv );
                }
            # 全体の日本語構文を 言語に変換する。
                while( Actions_Delta( \@in, \@match ) ) {};
            # 重複する置換定義を表示する。
                my @double = (); { # 抽出
                    my $n = "";
                    for( @label )  {
                        my $p = $n; $n = $_; @$p[0] eq @$n[0] || next;
                        @$p[1] ne @$n[1] || next;
                        push @double, [ @$p[0], @$p[1], @$n[1] ];
                    }
                }
                { # 整形
                    for( @double )  {
                        my ( undef, $a, $b, ) = @$_;
                        if( $a =~ /^\/$direct_mark\/(\d+)\/$/ ) { $a = @{$direct[ $1 ]}[1]; }
                        if( $b =~ /^\/$direct_mark\/(\d+)\/$/ ) { $b = @{$direct[ $1 ]}[1]; }
                        $a =~ /\S.*/ && ( $a = $`. $&, $a =~ s/^\s*/    / );
                        $b =~ /\S.*/ && ( $b = $`. $&, $b =~ s/^\s*/    / );
                        @$_[1] = $a; @$_[2] = $b;
                    }
                }
                { # 表示
                    @double &&
                        msg( 'double :', map do { "  @$_[0] ---", @$_[1], @$_[2] }, @double );
                }
            # 未定義の日本語シンボルを表示する。
                    @label_3 &&
                        msg( 'label auto ? :', map do { "  @$_[0] : @$_[1]" }, @label_3 );
            # 未変換の日本語シンボルを表示する。
                    my $n = "";
                    @unknown = map do {
                        my $p = $n; $n = $_; $p eq $n ? () : $n ;
                    }, sort { $a cmp $b } @unknown;
                    @unknown && msg( 'undefined :', map do { "    * $_ / " }, @unknown );
        }
        { # ファイルを出力する。
            # name文を処理する。
                my @fn; { # name文ごとに分割
                    @fn = ( [ '未指定', '', [ "" ] ] ); # ブロック名, ファイル名, 内容
                    for( @in ) {
                        if( /^\s*\/name(\s|\/|$)/ ) {
                            /(\x0a|$)/; $_ = $`; my $v = $';
                            /^\s*\/name(.*?)(\/|\x0a|$)/; my $k = $1; my $n = $';
                            $k =~ s/^\s*//;      $k =~ s/\s*$//;
                            $n =~ s/^\s*['"]?//; $n =~ s/['"]?\s*$//;
                            push @fn, [ $k, $n, [ $v ] ];
                            next;
                        }
                        push @{@{$fn[ @fn - 1 ]}[2]}, $_;
                    }
                }
                { # ブロック名によってファイル名を転記
                    my %name = ();
                    for( @fn ) {
                        ! defined( $name{ @$_[0] } ) || next;
                        @$_[0] ne "" && @$_[1] ne "" || next;
                        $name{ @$_[0] } = @$_[1];
                    }
                    for( @fn ) { @$_[1] eq "" && ( @$_[1] = $name{ @$_[0] } ); }
                }
            # 変換結果を出力して 終了する。
                { # ファイルがあれば 消す
                    msg( 'out :' );
                    for( @fn ) { @{@$_[2]} && @$_[1] ne "" && -f @$_[1] && unlink @$_[1]; }
                }
                { # name文を出力
                    my %name = ();
                    for( @fn ) {
                        @$_[0] eq '未指定' && @{@$_[2]} == 1 && @{@$_[2]}[0] eq '' && next;
                        @{@$_[2]} || next;
                        @$_[1] eq "" && msg( "  @$_[0] : ".'ファイル未指定' ) && next;
                        my $m = "  @$_[0] : @$_[1]";
                        defined( $name{ $m } ) || ( msg( $m ), $name{ $m } = 1 );
                        my $v = shift @{@$_[2]} ; $v =~ /\S/ && ( $v .= "\x0a" );
                        addF( @$_[1], $v );
                    }
                }
                { # 残りを出力
                    for( @fn ) {
                        @{@$_[2]} && @$_[1] ne "" || next;
                        -f @$_[1] && addF( @$_[1], join "\x0a", @{@$_[2]}, "" );
                    }
                }
                { # 終了
                    exit( 0 );
                }
        }
    }

# - ファイルの処理

# - 日本語構文の定義 ─ 定義を読む

    sub find_class_for_java { # まとめられるクラスを探す
            my $i; my $j;
            for( $i = 0; $i < @in; $i++ ) {
                $in[ $i ] =~ /^\s*\?(.*)\/\s*(.*\s)?class(\s|$)/ || next;
                my $l = $1; $l =~ s/^\s*//; $l =~ s/\s*$//; $l eq "" && next;
                $l = quotemeta_ja( $l );
                for( $j = 0; $j < $i; $j++ ) {
                    $in[ $j ] =~ /^\s*\?\s*$l\s*($|\/)/ && last;
                }
                $j < $i || next;
                return ( $j, $i );
            }
            return ();
    }

    sub class_end_for_java { # クラスの終わりを探す
        my @new; { # 処理結果
            /^\s*/; my $l = length( $& );
            for( my $i = $_[0] + 1; $i < @in; $i++ ) {
                for $m ( @re ) {
                    $in[ $i ] =~ /^(\s*)$m/ && length( $1 ) <= $l && return $i;
                }
            }
        }
    }

# - 日本語構文の定義 ─ 置換テーブルを作る

    sub ref_argument { # 引数の書式 を補正
            my ( $k, $v, ) = @{$_[0]};
        my @k; { # 日本語シンボルを補正
            @k = ( $k =~ /\(\s*[\w\.]+\s*\)/g );
            for( @k ) { /\(\s*([\w\.]+)\s*\)/; $_ = $1; }
            $k =~ s/\(\s*[\w\.]+\s*\)/\\s*(\\S+)\\s*/g;
            @{$_[0]}[0] = $k;
            @{$_[0]}[2] = quotemeta_ja( $k );
        }
        { # 言語シンボルを補正
            if( $v =~ /\((.*)\)/ ) {
                my $vt = $`; my $vs = $1; my $vp = $';
                $vt =~ /(((^|\s)new\s+)?[\w\.\:]+)\s*$/i && ( $vt = $1 );
                my @s = split ',', $vs;
                for( @s ) {
                    /(?:^|\s)(\w+)\s*$/ || next;
                    my $vk = $1;
                    my $n = 0; for( ; $n < @k; $n++ ) { $k[ $n ] eq $vk && last; }
                    $_ = $n < @k ? ' $'.( $n + 1 ) : $vk ;
                }
                $vs = join ', ', @s; $vs ne "" && ( $vs = " $vs " );
                $v = "$vt($vs)$vp";
            }
            else {
                $v =~ /(\S+)\s*$/ && ( $v = $1 );
            }
            @{$_[0]}[1] = $v;
        }
    }

    sub sort_conv { # 置換順
            my @a = ( @$a[0] =~ /\\S+/g ); my $lv_a = length( @$a[0] ) + @a * 100;
            my @b = ( @$b[0] =~ /\\S+/g ); my $lv_b = length( @$b[0] ) + @b * 100;
            $lv_b <=> $lv_a;
    }

    sub label_to_code { # 日本語シンボルの定義 の言語シンボルへの置換
            my $s = $_[0]; $s =~ s/^\s*//; $s =~ s/(\s*;)?\s*\/?$//;
            code_to_define( @{$label{ $s }}[0] );
    }

    sub code_to_define { # 置換後の言語シンボルの定義の補正
            $lang eq 'perl' ? code_for_perl( $_[0] ) :
            $lang eq 'java' ? code_for_java( $_[0] ) :
            $_[0];
    }

    sub code_for_perl { # perlのときの補正
            my $s = $_[0];
            if( $s =~ /\(/ ) { # 関数
                $s =~ /\(/ && ( $s = "sub $`" );
            }
            else { # 変数
                $s =~ s/\s*$/; /;
            }
            $s;
    }

    sub code_for_java { # javaのときの補正
            my $s = $_[0];
            if( $s =~ /\(/ ) { # メソッド・コンストラクタ
                    $s =~ s/^(\s*)new\s+/$1/;
                    $s =~ s/[\w\.]+\.(\w+\()/$1/;
            }
            elsif( $s =~ /(^|\s)class\s/ ) { # クラス
            }
            else { # プロパティ
                $s =~ s/\s*$/; /;
            }
            $s;
    }

    sub com_to_define { # 注釈と同時に定義された言語シンボルの補正
            my $c = $_[0];
            $c =~ s/^\s*//; $c =~ s/\s*$//;
            $c =~ /[^};]$/ && ( $c .= ';' );
            $c;
    }

    sub proc_to_code { # 日本語構文 の言語シンボルへの置換
        #  引数
            my $s = $_[0]; my $i = $_[1];
            $s =~ s/^\s*//; $s =~ s/\s*;(?=.\.\.\.\s*$)//; $s =~ s/\s*$//;
        { # 日本語構文の置換
            for( my $i = 0; $i < @parse; $i++ ) {
                my ( $k, $v, $f, ) = @{$parse[ $i ]};
                $s =~ /(?:^|\s)$f(\s|$)/ || next;
                my ( $t, $p, @v, ) = ( $`, $', $1, $2, $3, $4, $5, $6, $7, $8, $9 );
                $s = ( $t =~ /\S$/ ) ? $t." " : $t ;
                $s .= $v;
                $s .= ( $p =~ /^\S/ ) ? " ".$p : $p ;
                for( 1 .. 9 ) { $s =~ s/\$$_/$v[ $_ - 1 ]/g; }
                $i = 0;
            }
        }
        { # 日本語シンボルの置換
            for( my $i = 0; $i < @label; $i++ ) {
                my ( $k, $v, $f, ) = @{$label[ $i ]};
                $s =~ /(?:^|\s)$f(\s|$)/ || next;
                my ( $t, $p, @v, ) = ( $`, $', $1, $2, $3, $4, $5, $6, $7, $8, $9 );
                $s = ( $t =~ /\S$/ ) ? $t." " : $t ;
                $s .= $v;
                $s .= ( $p =~ /^\S/ ) ? " ".$p : $p ;
                for( 1 .. 9 ) { $s =~ s/\$$_/$v[ $_ - 1 ]/g; }
                $i = 0;
            }
        }
        { # 未変換の日本語シンボルの抽出
            if( $s =~ /[^\x00-\x7f]/ ) {
                push @ unknown, $s =~ /\S*[^\x00-\x7f]+\S*/g;
            }
        }
        my $re; { # 行頭記号
            $re = '^\s*('.( join "|", @re ).")";
        }
        { # 言語コードへの置換
            $s =~ s/^\s*/$i    /;
            while( $s =~ /\/$direct_mark\/(\d+)\/\s*/ ) {
                my ( $t, $p, $n, ) = ( $`, $', $1, );
                my $v = @{$direct[ $n ]}[1];
                my $m = ( $v =~ /\x0a/ || $v =~ /$re/ );
                if( ! $m ) { $v =~ s/^\s*//; $v =~ s/\s*$//; }
                if( $m ) {
                    $v = "\x0a$v"; $v =~ s/\x0a/$&$i/g;
                    if( $t =~ /^\s*$/ ) { $t = ""; $v=~ s/^\x0a//; }
                    else { $v =~ s/\x0a/$&    /g; }
                    $p =~ /\S/ && ( $p = "\x0a$i    $p" );
                }
                $s = ( $t =~ /\S$/ ) ? $t." " : $t ;
                $s .= $v;
                $s .= ( $p =~ /^\S/ ) ? " ".$p : $p ;
            }
        }
        { # 表示（ debug用 ）
            ; ### my $m = $s; $m =~ s/(^|\x0a)        /$1/g; msg( $m );
        }
        { # 行末に ; を補う
            $s =~ s/(?=.*$)(.*?[^,;:{}(?\s]=)(\s*(\s$com_mark|$))/$1 ;$2/;
        }
        { #
            $s;
        }
    }

# - 日本語構文の変換 ─ Actions / Delta

    sub Actions_Delta { # 最深の日本語構文を探し 変換する。
            map do { Delta( $_, @_ ), 1; }, Actions( @_ );
    }

    sub Actions { # 最深の日本語構文を探す。
        my ( $in, $match, ) = @_; # 引数
        my @sp; { # 各行を書式とマッチした結果（ 行頭空白の長さの配列 ）
            my @re = map do { $_->{ regexp } }, @$match;
            @sp = map do {
                my $sp = -1;
                for $re ( @re ) { /$re/i && ( $sp = length( $1 ), last ); }
                /^(\s*)\/name(?=\s|\/|$)/ && ( $sp = -1 ); # name文を除外
                $sp;
            }, @$in;
        }
        my $p; { # 行頭空白の長さが最大の行
            $p = 0; my $n = 1; my $sp = -1;
            map do { $sp < $_ && ( $sp = $_, $p = $n ); $n++; }, @sp;
        }
        { # $pを返す（ マッチした行がないときは 空 ）
            $p < 1 ? () : ( $p - 1 );
        }
    }

    sub Delta { # 最深の日本語構文を変換する。
        my ( undef, $in, $match, ) = @_; # 引数
        my $s; # 始めの行
        my $e; # 終わりの行
        { # 書式とマッチし 始めの行，終わりの行 を作る。
            for( $m = 0; $m < @$match; $m++  ) {
                if( @$in[ $_[0] ] =~ /@$match[ $m ]->{ regexp }/i ) {
                    $s = eval( @$match[ $m ]->{start} ); $r = $';
                    $e = eval( @$match[ $m ]->{end} );
                    last;
                }
            }
        }
        { # 始めの行を補正
            $lang eq 'perl' && ( $s =~ s/^(\s*)(package\s.*?)({\s*)/$1$3$2/i );
            my $m = quotemeta( $com_start );
            if( $s =~ /^(\s*)($m)/ ) {
                $s = $2.$';
                $s =~ s/(\x0a)\s*\?\?\//$1$com_end/;
            }
        }
        { # ; が重複する場合 削除
            $s =~ s/;(\s*(\s$com_mark.*)?\x0a\s*;)/$1/;
        }
        { # 始めの行を置換（ 空行のときは 削除 ）。
            @$in[ $_[0] ] = $s;
            $s =~ /^\s*$/ && splice( @$in, $_[0], 1 );
        }
        my $p; { # 終わりの行の挿入位置を検索する。
            $p = $_[0] + 1;
            my $i = ( $s =~ /^\s*/ && length( $& ) );
            my @re = map do { $_->{ regexp } }, @$match;
            for( ; $e && $p < @$in; $p++ ) {
                my $sp = -1;
                for $re ( @re ) {
                    @$in[ $p ] =~ /$re/i && ( $sp = length( $1 ), last );
                }
                $sp < 0 || $sp <= $i && last;
            }
            while( @$in[ $p - 1 ] =~ /^\s*$/ ) { $p-- }
        }
        { # ブロック内が空なら ブロックを削除する。
            $p == $_[0] + 1 && ! ( $s =~ /\x0a/ ) && $e =~ /^\s*\}/ &&
                $s =~ /^(.*?)\{\s*($com_mark|$)/ &&
                    ( @$in[ $_[0] ] = "$1$2$'", $e = "" );
        }
        { # ブロック内が空なら ブロックに空文を挿入する。
            $p == $_[0] + 1 && ( $s =~ /\x0a\s*$/ ) && $e =~ /^\s*\}/ &&
                $s =~ /^(.*?)\{\s*($com_mark|$)/ &&
                    ( @$in[ $_[0] ] .= ";" );
        }
        { # 終わりの行を挿入。
            $e && splice( @$in, $p, 0, $e );
        }
    }

# - 補助の定型ルーチン

#    # quotemeta_ja for cp932
#    sub quotemeta_ja { # 日本語用のquotemeta( ？ )
#        join '', map do{ s/(.)([\x40\x5b-\x60\x7b-\x7f])/$1\\$2/; $_ ; },
#            ( $_[0] =~ /([\x00-\x7f\xa0-\xdf]|..)/g );
#    }

    # quotemeta_ja for utf8
    sub quotemeta_ja { # 日本語用のquotemeta( ？ )
        $_[0];
    }

    sub getF { # ファイル( ？ )を読む。
        open( IN, '<'.$_[0] ) || err( 'オープンエラー：'.$_[0] );
        my @buf = <IN>; close( IN );
        @buf;
    }

    sub addF { # ファイル( ？ )に( ？ )を追加出力する。
        open( OUT, '>>'.$_[0] ) || err( 'オープンエラー：'.$_[0] );
        print OUT $_[1]; close( OUT );
    }

    sub err { # メッセージ( ？ )を表示して エラー終了する。
        msg( @_ ); exit( 1 );
    }

    sub msg { # メッセージ( ？ )を表示する。
        print map do { $_."\x0a" }, @_;
    }

# - 構文

# - ライセンス
# ~ スクリプトの冒頭に記述。


